home *** CD-ROM | disk | FTP | other *** search
Text File | 1987-06-17 | 9.9 KB | 422 lines | [TEXT/PJMM] |
- { MenuFun by Steve Sheets 6/3/87 }
-
- { Simple Demonstration of Mac // Menu Manager. }
-
- PROGRAM LMC;
-
- { Various Constants: Menu ID Numbers }
- CONST
- AppleMenuID = 40;
- FileMenuID = 41;
- EditMenuID = 42;
- DisplayMenuID = 43;
- ColorMenuID = 44;
- FontMenuID = 45;
- SizeMenuID = 46;
- StyleMenuID = 47;
- JustMenuID = 48;
- FColorMenuID = 49;
- BColorMenuID = 50;
-
- { Various Variables: Menus, Window, Text, Rectangle, Done Flag, }
- { Colors, Font, Size and Justification Settings. }
- VAR
- AppleMenu, FileMenu, EditMenu, DisplayMenu, ColorMenu, FontMenu, SizeMenu, StyleMenu, JustMenu, FColorMenu, BColorMenu : MenuHandle;
- MyWindow : windowptr;
- Done : boolean;
- MyStr : str255;
- MyRect : Rect;
- MyFColor, MyBColor, MyFont, MySize, MyJust : integer;
- MyBold, MyItalic, MyUnderline, MyOutline, MyShadow, MyCondense, MyExtend : boolean;
- MyStyle : Style;
-
- { Redraws the window, by creating an update event. }
- PROCEDURE ReDraw;
- VAR
- tempPort : Grafptr;
- BEGIN
- GetPort(tempPort);
- SetPort(MyWindow);
- InvalRect(MyRect);
- SetPort(tempPort);
- END;
-
- { Given the style settings, checks the various Style Menus and creates }
- { the correct Style variable. }
- PROCEDURE CheckStyle;
- BEGIN
- MyStyle := [];
- IF MyBold THEN
- BEGIN
- SetItemMark(StyleMenu, 1, CHAR(diamondMark));
- MyStyle := MyStyle + [Bold];
- END
- ELSE
- SetItemMark(StyleMenu, 1, CHAR(noMark));
- IF MyItalic THEN
- BEGIN
- SetItemMark(StyleMenu, 2, CHAR(diamondMark));
- MyStyle := MyStyle + [Italic];
- END
- ELSE
- SetItemMark(StyleMenu, 2, CHAR(noMark));
- IF MyUnderLine THEN
- BEGIN
- SetItemMark(StyleMenu, 3, CHAR(diamondMark));
- MyStyle := MyStyle + [Underline];
- END
- ELSE
- SetItemMark(StyleMenu, 3, CHAR(noMark));
- IF MyOutline THEN
- BEGIN
- SetItemMark(StyleMenu, 4, CHAR(diamondMark));
- MyStyle := MyStyle + [Outline];
- END
- ELSE
- SetItemMark(StyleMenu, 4, CHAR(noMark));
- IF MyShadow THEN
- BEGIN
- SetItemMark(StyleMenu, 5, CHAR(diamondMark));
- MyStyle := MyStyle + [Shadow];
- END
- ELSE
- SetItemMark(StyleMenu, 5, CHAR(noMark));
- IF MyCondense THEN
- BEGIN
- SetItemMark(StyleMenu, 6, CHAR(diamondMark));
- MyStyle := MyStyle + [Condense];
- END
- ELSE
- SetItemMark(StyleMenu, 6, CHAR(noMark));
- IF MyExtend THEN
- BEGIN
- SetItemMark(StyleMenu, 7, CHAR(diamondMark));
- MyStyle := MyStyle + [Extend];
- END
- ELSE
- SetItemMark(StyleMenu, 7, CHAR(noMark));
- END;
-
- { Given the color number (1-8), returns the correct color constant. }
- FUNCTION GetColor (C : integer) : longint;
- BEGIN
- CASE C OF
- 1 :
- GetColor := BlackColor;
- 2 :
- GetColor := WhiteColor;
- 3 :
- GetColor := RedColor;
- 4 :
- GetColor := GreenColor;
- 5 :
- GetColor := BlueColor;
- 6 :
- GetColor := CyanColor;
- 7 :
- GetColor := MagentaColor;
- 8 :
- GetColor := YellowColor;
- END;
- END;
-
- { Draws the Text in the Rectangle in the correct Colors, Font, }
- { Size, Style and Justification. }
- PROCEDURE DoDraw;
- VAR
- tempStr : str255;
- tempInteger : integer;
- BEGIN
- ForeColor(GetColor(MyFColor));
- BackColor(GetColor(MyBColor));
- GetItem(FontMenu, MyFont, tempStr);
- GetFNum(tempStr, tempInteger);
- TextFont(tempInteger);
- CASE MySize OF
- 1 :
- TextSize(9);
- 2 :
- TextSize(10);
- 3 :
- TextSize(12);
- 4 :
- TextSize(18);
- 5 :
- TextSize(24);
- 6 :
- TextSize(32);
- END;
- TextFace(MyStyle);
- TextBox(POINTER(ord4(@MyStr) + 1), LENGTH(MyStr), MyRect, MyJust - 2);
- END;
-
- { Edit the Text. }
- PROCEDURE DoEdit;
- VAR
- MyDialog : DialogPtr;
- N : integer;
- MyH : handle;
- MyR : rect;
- BEGIN
- MyDialog := GetNewDialog(130, NIL, POINTER(-1));
- GetDItem(MyDialog, 4, N, MyH, MyR);
- SetIText(MyH, MyStr);
-
- REPEAT
- ModalDialog(NIL, N);
- UNTIL (N = 1) OR (N = 2);
-
- IF N = 1 THEN
- BEGIN
- GetIText(MyH, MyStr);
- ReDraw;
- END;
-
- DisposDialog(MyDialog);
- END;
-
- { Standard main menu procedure that handles menu selections. Can show }
- { About Box, Edit the Text, change the Done Flag (so the program quits), }
- { handle edit commands (Cut,Copy,Paste,Clear), and change all the Colors, }
- { Font, Size, Style and Justification of the Text. }
- PROCEDURE MainMenu (tempResult : LONGINT);
- VAR
- tempInteger : integer;
- tempStr : str255;
- BEGIN
- tempInteger := LoWord(tempResult);
- CASE HiWord(tempResult) OF
- AppleMenuID :
- IF tempInteger = 1 THEN
- tempInteger := Alert(128, NIL)
- ELSE
- BEGIN
- GetItem(appleMenu, tempInteger, tempStr);
- tempInteger := OpenDeskAcc(tempStr);
- END;
- FileMenuID :
- IF tempInteger = 1 THEN
- DoEdit
- ELSE IF tempInteger = 3 THEN
- Done := (Alert(129, NIL) = 2);
- EditMenuID :
- IF NOT SystemEdit(tempInteger - 1) THEN
- sysbeep(1);
- FColorMenuID :
- IF (tempInteger <> 0) AND (tempInteger <> MyFColor) THEN
- BEGIN
- CheckItem(FColorMenu, MyFColor, false);
- MyFColor := tempInteger;
- CheckItem(FColorMenu, MyFColor, true);
- ReDraw;
- END;
- BColorMenuID :
- IF (tempInteger <> 0) AND (tempInteger <> MyBColor) THEN
- BEGIN
- CheckItem(BColorMenu, MyBColor, false);
- MyBColor := tempInteger;
- CheckItem(BColorMenu, MyBColor, true);
- ReDraw;
- END;
- FontMenuID :
- IF (tempInteger <> 0) AND (tempInteger <> MyFont) THEN
- BEGIN
- CheckItem(FontMenu, MyFont, false);
- MyFont := tempInteger;
- CheckItem(FontMenu, MyFont, true);
- ReDraw;
- END;
- SizeMenuID :
- IF (tempInteger <> 0) AND (tempInteger <> MySize) THEN
- BEGIN
- CheckItem(SizeMenu, MySize, false);
- MySize := tempInteger;
- CheckItem(SizeMenu, MySize, true);
- ReDraw;
- END;
- StyleMenuID :
- BEGIN
- CASE tempInteger OF
- 1 :
- MyBold := NOT MyBold;
- 2 :
- MyItalic := NOT MyItalic;
- 3 :
- MyUnderLine := NOT MyUnderLine;
- 4 :
- MyOutline := NOT MyOutline;
- 5 :
- MyShadow := NOT MyShadow;
- 6 :
- MyCondense := NOT MyCondense;
- 7 :
- MyExtend := NOT MyExtend;
- OTHERWISE
- END;
- CheckStyle;
- ReDraw;
- END;
- JustMenuID :
- IF (tempInteger <> 0) AND (tempInteger <> MyJust) THEN
- BEGIN
- CheckItem(JustMenu, MyJust, false);
- MyJust := tempInteger;
- CheckItem(JustMenu, MyJust, true);
- ReDraw;
- END;
- OTHERWISE
- END;
- HiliteMenu(0);
- END;
-
- { Setup for Menus, Window, Done flag, Text, Rectangle, Colors, Font, }
- { Size, Style and Justification of the Text.}
- PROCEDURE DoSetup;
- BEGIN
- AppleMenu := GetMenu(AppleMenuID);
- AddResMenu(AppleMenu, 'DRVR');
-
- FileMenu := GetMenu(FileMenuID);
-
- EditMenu := GetMenu(EditMenuID);
-
- DisplayMenu := GetMenu(DisplayMenuID);
-
- ColorMenu := GetMenu(ColorMenuID);
-
- FontMenu := GetMenu(FontMenuID);
- AddResMenu(FontMenu, 'FONT');
- MyFont := 1;
- CheckItem(FontMenu, MyFont, true);
-
- SizeMenu := GetMenu(SizeMenuID);
- MySize := 3;
- CheckItem(SizeMenu, MySize, true);
-
- StyleMenu := GetMenu(StyleMenuID);
- MyBold := false;
- MyItalic := false;
- MyUnderLine := false;
- MyOutline := false;
- MyShadow := false;
- MyCondense := false;
- MyExtend := false;
- CheckStyle;
-
- JustMenu := GetMenu(JustMenuID);
- MyJust := 3;
- CheckItem(JustMenu, MyJust, true);
-
- FColorMenu := GetMenu(FColorMenuID);
- MyFColor := 1;
- CheckItem(FColorMenu, MyFColor, true);
-
- BColorMenu := GetMenu(BColorMenuID);
- MyBColor := 2;
- CheckItem(BColorMenu, MyBColor, true);
-
- InsertMenu(AppleMenu, 0);
- InsertMenu(FileMenu, 0);
- InsertMenu(EditMenu, 0);
- InsertMenu(DisplayMenu, 0);
- InsertMenu(ColorMenu, -1);
- InsertMenu(FontMenu, -1);
- InsertMenu(SizeMenu, -1);
- InsertMenu(StyleMenu, -1);
- InsertMenu(JustMenu, -1);
- InsertMenu(FColorMenu, -1);
- InsertMenu(BColorMenu, -1);
-
- DrawMenuBar;
-
- MyWindow := GetNewWindow(128, NIL, POINTER(-1));
-
- MyRect := MyWindow^.portRect;
-
- GetIndString(MyStr, 128, 1);
-
- InitCursor;
-
- Done := false;
- END;
-
- { Standard main program loop that handles all events (ie. mouse down, key }
- { downs & updates) until the Done flag is set. }
- PROCEDURE MainLoop;
- VAR
- tempEvent : EventRecord;
- tempWindow : windowptr;
- tempCode : integer;
- tempPort : Grafptr;
- tempRect : rect;
- tempLong : longint;
- BEGIN
- REPEAT
- SystemTask;
- IF GetNextEvent(everyEvent, tempEvent) THEN
- BEGIN
- CASE tempEvent.what OF
- mouseDown :
- BEGIN
- tempCode := FindWindow(tempEvent.where, tempWindow);
- CASE tempCode OF
- inDrag, inContent :
- BEGIN
- IF tempWindow <> FrontWindow THEN
- SelectWindow(tempWindow)
- ELSE
- BEGIN
- IF MyWindow = tempWindow THEN
- BEGIN
- SetRect(tempRect, -25000, -25000, 25000, 25000);
- DragWindow(MyWindow, tempEvent.where, tempRect);
- END;
- END;
- END;
- inGrow :
- BEGIN
- IF tempWindow <> FrontWindow THEN
- SelectWindow(tempWindow)
- ELSE
- BEGIN
- IF MyWindow = tempWindow THEN
- BEGIN
- SetRect(tempRect, -25000, -25000, 25000, 25000);
- tempLong := GrowWindow(MyWindow, tempEvent.where, tempRect);
- SizeWindow(MyWindow, LoWord(tempLong), HiWord(tempLong), false);
- MyRect := MyWindow^.portRect;
- ReDraw;
- END;
- END;
- END;
- inMenuBar :
- MainMenu(MenuSelect(tempEvent.where));
- inSysWindow :
- SystemClick(tempEvent, tempWindow);
- OTHERWISE
- END; { of tempCode case }
- END; { of mouseDown }
- keydown, autoKey :
- IF BitAnd(tempEvent.modifiers, cmdKey) <> 0 THEN
- MainMenu(MenuKey(CHR(tempEvent.message MOD 256)));
- updateEvt :
- IF MyWindow = WindowPtr(tempEvent.message) THEN
- BEGIN
- GetPort(tempPort);
- SetPort(MyWindow);
- BeginUpdate(MyWindow);
- DoDraw;
- EndUpdate(MyWindow);
- SetPort(tempPort);
- END;
- OTHERWISE
- END;
- END;
- UNTIL Done;
- END;
-
- { ***PROGRAM*** }
- BEGIN
- DoSetup;
- MainLoop;
- END.